#!/usr/bin/perl -w

#-P-R-O-G-R-A-M---------------------------------------------------------------#
#                                                                             #
#                      Neeley's Download Tracker 0.1.5                        #
#                                                                             #
#-C-R-E-A-T-E-D-_-B-Y---------------------------------------------------------#
#                                                                             #
#                Patrick Neeley           <patrick@neeley.org>                #
#             Neeley Studios, Ltd.       http://www.neeley.org/               #
#                                                                             #
#                   Copyright (c) 2001- Patrick Neeley                        #
#                                                                             #
#          Last update to this copy, by Patrick Neeley: 10/10/2004.           #
#                                                                             #
#-----------------------------------------------------------------------------#
#-L-I-C-E-N-S-E---------------------------------------------------------------#
#                                                                             #
# This software is free.  Use it, modify it, build on it, whatever.  DO NOT   #
# SELL THIS PRODUCT OR CHANGE THE CONTACT INFORMATION IF YOU DO NOT MAKE      #
# CONSIDERABLE MODIFICATIONS TO THE CODE.  Doing so is called plagarism,      #
# because, even though the software is free to use, this version was created  #
# by Patrick Neeley, so it's not yours to sell.                               #
#                                                                             #
# If you do make considerable changes to the software, I'd appreciate a kudo  #
# in the source code ;) .  Not necessary, but it feeds the ego, and the ego   #
# needs feeding.                                                              #
#                                                                             #
# Original license, updates to the software, and other information can be     #
# found on my web site at: http://www.neeley.org/nps/                         #
#                                                                             #
#-U-P-D-A-T-E-S---------------------------------------------------------------#
#                                                                             #
# date        v      comments                                                 #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 2004-10-10  0.1.5  Added "View All" functionality for file entries.         #
# 2004-07-16  0.1.4  Changed e-mail statview link to sort by date.            #
# 2004-06-07  0.1.3  Added email notification (CNF opt; no switch cuz no CP.) #
#                                                                             #
#-----------------------------------------------------------------------------#


use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $cgi = new CGI;

my $selfurl = $cgi->url;
my $baseurl = $selfurl;
   $baseurl =~ s/\/([^\/]+)$//;
my $sfile = $1;

my %CNF = ( logdir => '/home/neeley/logs/dl',  # log directory (chmod 777)
            filelist => '/home/neeley/dlfiles.txt',  # file list
            email => 'logmaster@neeley.org',  # e-mail address; always use ' to enclose
            dl_notify => 1,  # notify of downloads (failed and successful)
            sendmail => '/usr/sbin/sendmail -t',
            sdshow => 13,  # number of detailed hit-lines to show for each file
                           # set to zero (0) to disable
            );

`chmod 777 "$CNF{logdir}"/*`;

my $headtag = qq|<html>
 <body bgcolor="white" text="black" link="blue" vlink="blue" alink="lightblue">
 <font face="Verdana">
 <table border=0 cellspacing=0 cellpadding=0><tr><td align=right>
  <font face="Verdana">
  <font size=5>Neeley\'s DL Tracker 0.1</font><br>
  <font size=4> &nbsp; &nbsp; &nbsp; &nbsp; Statistics Display</font><br>
  </font>
 </td></tr></table><br>
|;

my $foottag = qq|
 <p align=center>Copyright (c) 2001- <a href="mailto:coder\@neeley.org">Patrick Neeley</a></p>
 </font>
 </body></html>
|;

my %FILES;

open (FL, "$CNF{filelist}")
 or die("Could not open $CNF{filelist} to read [$!]");
while (my $line = <FL>)
 { chomp($line);
   my ($id,$url) = split(/\|/, $line);
   $FILES{$id} = $url;
 }
close(FL);

my $VIEW_MODE = 0;
my $view_id = $cgi->param('view_id');
if ($view_id ne '' && defined($FILES{$view_id})) {
  %FILES = ( $view_id => $FILES{$view_id} );
  $VIEW_MODE = 1;
}

my $act = $cgi->param('action');

if ($act eq 'download')    # DOWNLOAD
 { my $logfile;
   my $fid = $cgi->param('fileid');
   my $ts = getDTStamp();
   my $remhost = $cgi->remote_host;
   $remhost eq '' and $remhost = 'null';
   my $remhost_dn = 'null';
   if ($remhost =~ /^(\d{1,3}\.){3}\d{1,3}$/)
    { use Socket;
      my $rh_nbo = inet_aton($remhost);
      if (!$rh_nbo || !($remhost_dn = gethostbyaddr($rh_nbo, AF_INET)))
       { $remhost_dn = '(unable to get host name)'; }
    }

   my $referer = $cgi->referer;
   $referer eq '' and $referer = 'null';

   my $dl_ok = 1;

   if (!defined($FILES{$fid}))
    { $dl_ok = 0;
      $logfile = "$CNF{logdir}/unknowns";
      (-e $logfile) or `touch "$logfile"`;

      if (open (LF, ">>$logfile"))
       { print LF join('|', $fid, $ts, $cgi->remote_host(), $cgi->referer()) . "\n";
         close(LF);
       }
      print $cgi->header . qq|
       $headtag
       <p><b>ERROR</b></p>
       <p>I\'m terribly sorry, but I couldn\'t find a file with the ID $fid.&nbsp;
       This request has been logged, and the webmaster will be checking on it, but 
       you might want to <a href="mailto:$CNF{'email'}?subject=ERROR $fid NOT FOUND">e-mail
       him anyway</a> to let him know what has happened.</p>
       $foottag
      |;
    }
   else
    { $logfile = "$CNF{logdir}/$fid";
      (-e $logfile) or `touch "$logfile"`;
      if (open (LF, ">>$logfile"))
       { print LF join('|', $fid, $ts, $remhost, $referer) . "\n";
         close(LF);
       }
    }

   my ($d,$t) = dtLogStampToDTShort($ts);
   my $mail_msg = "DL Status: ".($dl_ok ? 'Succeeded': 'Failed')."\nFile ID: $fid\n".
                  "File URL: $FILES{$fid}\n\nDate/Time Stamp: $d $t\n\nRemote Host IP: $remhost\n".
                  "Remote Host DN: $remhost_dn\nReferring URL: $referer\n\n".
                  "NDLT StatView:\n$baseurl/$sfile\?action=statview&sort=ad\n\n".
                  "Remember http://neeley.org/nps/ for your empire-crumbling code-crunching needs!";

   if ($CNF{'sendmail'} ne '' && open (SM, "|$CNF{'sendmail'}"))
    { print SM "From: \"NDLT\" <$CNF{'email'}>\nTo: $CNF{'email'}\n".
               "Subject: [NDLT] Download Notification\n\n$mail_msg\n\n";
      close(SM);
    }

   $dl_ok and print $cgi->redirect($FILES{$fid});
 }

elsif ($act eq 'statview')    # STATVIEW
 { print $cgi->header . $headtag;

 # GATHER

   my %INFO = ();
   my $hitCount = 0;
   my $vizCount = 0;
   my $fileCount = scalar(keys(%FILES));

   foreach my $id (sort {$a cmp $b} keys %FILES)
    { my $logfile = "$CNF{logdir}/$id";
      $INFO{$id}->{'hitCount'} = 0;
      $INFO{$id}->{'vizCount'} = 0;
      if (!open(LF, "$logfile"))
       { } # print qq|<font size=2 color="red"><b>Could not open $logfile to read.</b><br></font>\n|; }
      else
       { my %usedips;
         while (<LF>)
          { chomp;
            my ($lid, $dts, $vipa, $rurl) = split(/\|/);
            my $odts = $dts;
            my $date = substr($dts,0,8,'');
            substr($date,6,0,'-');
            substr($date,4,0,'-');
            my $time = $dts;
            substr($time,4,0,':');
            substr($time,2,0,':');
            push @{$INFO{$id}->{'hits'}}, {'rawdt'=>$odts,'date'=>$date,'time'=>$time,'vipa'=>$vipa,'rurl'=>$rurl};
            ++$INFO{$id}->{'hitCount'};
            if ($vipa eq 'null' || !$usedips{$vipa})
             { ++$INFO{$id}->{'vizCount'};
               $vipa eq 'null' or $usedips{$vipa} = 1;
             }
          }
         close(LF);
         $hitCount += $INFO{$id}->{'hitCount'};
         $vizCount += $INFO{$id}->{'vizCount'};
         my ($lad, $lat, $las);
         if (defined($INFO{$id}->{'hits'}))
          { my @hia = @{$INFO{$id}->{'hits'}};
            $lad = $hia[$#hia]->{'date'};
            $lat = $hia[$#hia]->{'time'};
            $las = $hia[$#hia]->{'rawdt'};
          }
         $INFO{$id}->{'ladate'} = $lad;
         $INFO{$id}->{'latime'} = $lat;
         $INFO{$id}->{'lasort'} = $las;
       }
    }
   print qq|<br>\n|;

 # DISPLAY

   my @fkeys;
   my $stype = lc($cgi->param('sort'));
   if ($stype eq 'fn')
    { @fkeys = sort 
       { my $fna = $FILES{$a};
         $fna =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
         $fna =~ /\/([^\/]+)$/;
         $fna = $1;
         my $fnb = $FILES{$b};
         $fnb =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
         $fnb =~ /\/([^\/]+)$/;
         $fnb = $1;
         uc($fna) cmp uc($fnb);
       } keys %FILES;
    }
   elsif ($stype eq 'hc')
    { @fkeys = sort { $INFO{$b}->{'hitCount'} <=> $INFO{$a}->{'hitCount'} } keys %FILES; }
   elsif ($stype eq 'vc')
    { @fkeys = sort { $INFO{$b}->{'vizCount'} <=> $INFO{$a}->{'vizCount'} } keys %FILES; }
   elsif ($stype eq 'ad')
    { @fkeys = sort { $INFO{$b}->{'lasort'} <=> $INFO{$a}->{'lasort'} } keys %FILES; }
   else
    { @fkeys = sort {$a cmp $b} keys %FILES;  $stype = 'id'; }

   my %CCh = ( 'idC0'=>'','idC1'=>'','idL0'=>qq|<a href="$sfile\?action=statview&sort=id">|,'idL1'=>'</a>',
               'fnC0'=>'','fnC1'=>'','fnL0'=>qq|<a href="$sfile\?action=statview&sort=fn">|,'fnL1'=>'</a>',
               'hcC0'=>'','hcC1'=>'','hcL0'=>qq|<a href="$sfile\?action=statview&sort=hc">|,'hcL1'=>'</a>',
               'vcC0'=>'','vcC1'=>'','vcL0'=>qq|<a href="$sfile\?action=statview&sort=vc">|,'vcL1'=>'</a>',
               'adC0'=>'','adC1'=>'','adL0'=>qq|<a href="$sfile\?action=statview&sort=ad">|,'adL1'=>'</a>',
             );
   $CCh{$stype .'C0'} = qq| bgcolor="\#e4f0e4"|;
   $CCh{$stype .'C1'} = qq| bgcolor="\#e4e4f0"|;
   $CCh{$stype .'L0'} = '';
   $CCh{$stype .'L1'} = '';

   print qq|
    <table cellspacing=0 cellpadding=5 border=1 width=100%>
     <tbody style="font-family:Verdana; font-size:11px;">
     <tr bgcolor="#e0e0e0">
      <td colspan=5>
       <font style="font-size:12px;"><b>Quick Stats</b> &nbsp; &nbsp; </font>
       <font style="font-size:10px;">Select the file ID to view detailed stats for that file.</font>
      </td>
     </tr>
     <tr bgcolor="#f4f8f4">
      <td align=center$CCh{'idC0'}><b>$CCh{'idL0'}file id$CCh{'idL1'}</b></td>
      <td align=center$CCh{'fnC0'}><b>$CCh{'fnL0'}file name$CCh{'fnL1'}</b></td>
      <td align=center$CCh{'hcC0'}><b>$CCh{'hcL0'}hits$CCh{'hcL1'}</b></td>
      <td align=center$CCh{'vcC0'}><b>$CCh{'vcL0'}visits$CCh{'vcL1'}</b></td>
      <td align=center$CCh{'adC0'}><b>$CCh{'adL0'}last access$CCh{'adL1'}</b></td>
     </tr>
   |;

   foreach my $id (@fkeys)
    { my $fn = $FILES{$id};
      $fn =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $fn =~ /\/([^\/]+)$/;
      $fn = $1;
      my ($lad, $lat) = ($INFO{$id}->{'ladate'}, $INFO{$id}->{'latime'});
      $lad =~ s/\s//g;     $lat =~ s/\s//g;
      $lad or $lad = '~';  $lat or $lat = '~';
      print qq|
       <tr bgcolor="#f4f4f8">
        <td$CCh{'idC1'}><a href="#$id">$id</a></td>
        <td$CCh{'fnC1'}><a href="$FILES{$id}">$fn</a></td>
        <td align=right$CCh{'hcC1'}>$INFO{$id}->{'hitCount'}</td>
        <td align=right$CCh{'vcC1'}>$INFO{$id}->{'vizCount'}</td>
        <td align=center$CCh{'adC1'}>$lad $lat</td>
       </tr>
      |;
    }
   print qq|
     <tr bgcolor="#f8f4f4">
      <td colspan=2 align=center><b>$fileCount Active Files</b></td>
      <td align=right><b>$hitCount</b></td>
      <td align=right><b>$vizCount</b></td>
      <td>&nbsp;</td>
     </tr>
     </tbody>
    </table><br><br><br>
    <SCRIPT LANGUAGE="JavaScript">
     <!--//
      function openCustomWindow(url)
       { var sx = (screen.availWidth / 2) - 180;
         var sy = (screen.availHeight  / 2) - 60;
         window.open( url, 'ndltip2dnWin',
         'height=120,width=360,resizable=no,menubar=no,location=no,' +
         'directories=no,status=no,scrollbars=no,dependent=yes,left=' +
         sx + ',top=' + sy );
       }
      function openViewWindow(url)
       { var sx = (screen.availWidth / 2) - 400;
         var sy = (screen.availHeight  / 2) - 320;
         window.open( url, 'ndltip2dnWin',
         'height=500,width=800,resizable=yes,menubar=no,location=no,' +
         'directories=no,status=yes,scrollbars=yes,dependent=yes,left=' +
         sx + ',top=' + sy );
       }
     //-->
    </SCRIPT>
   |;

   my $ip2dn = "$baseurl/ip2dn.cgi\?ip";
   foreach my $id (sort {$a cmp $b} keys %FILES)
    { my $logfile = "$CNF{logdir}/$id";
      print qq|<a name="$id">\n|;
      if (!open(LF, "$logfile"))
       { print qq|<font color="red"><b>Could not open $logfile to read.</b></font><br><br>\n|; }
      else
       { my $furl = $FILES{$id};
         my $xturl = $cgi->self_url();
         $xturl .= (($xturl =~ /\?/) ? "&":"?"). "view_id=$id";
         my $view_link = $VIEW_MODE ? "": qq|&nbsp; <a href=\"javascript\:openViewWindow(\'$xturl\');\">View All</a>|;
         my $max_shown = $VIEW_MODE ? "": qq|&nbsp; [max shown: $CNF{'sdshow'}]|;
         $furl =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
         print qq|
          <table cellspacing=0 cellpadding=5 border=0 width=100%>
           <tbody style="font-family:Verdana">
           <tr bgcolor="#808084" style="font-size:10px; color:#ffffff"><td colspan=4></td></tr>
           <tr bgcolor="#e0e0e4">
            <td colspan=3><b>$id</b> &nbsp;-&nbsp; $INFO{$id}->{'hitCount'} Accesses $max_shown $view_link</td>
            <td align=right><font style="font-size:10px;"><a href="#top">TOP</a></font></td>
           </tr>
           <tr bgcolor="#f4f4f8"><td colspan=4><font style="background-color:#f2f2f2">$furl</font></td></tr>
           <tr bgcolor="#808084" style="font-size:10px; color:#ffffff">
            <td>DATE</td><td>TIME</td><td>VISITOR</td><td>REF URL</td>
           </tr>
         |;

         my $cs = 0;
         my $sicnt = 0;
         foreach my $ihr (sort { $b->{'date'} . $b->{'time'} cmp $a->{'date'} . $a->{'time'} } @{$INFO{$id}->{'hits'}})
          { my $refurl = ($ihr->{'rurl'} eq 'null') ?
             $ihr->{'rurl'}:
             qq|<a href="$ihr->{'rurl'}" target="new">$ihr->{'rurl'}</a>|;
            print qq|
             <tr bgcolor=\"\#| . ('e0e0e4','f0f0f4')[$cs]  . qq|\">
              <td nowrap>$ihr->{'date'}</td>
              <td nowrap>$ihr->{'time'}</td>
              <td nowrap><a href="javascript\:openCustomWindow(\'$ip2dn\=$ihr->{'vipa'}\')\;">$ihr->{'vipa'}</a></td>
              <td width=50%>$refurl</td>
             </tr>
            |;
            $cs ? --$cs : ++$cs;
            if (!$VIEW_MODE && ++$sicnt == $CNF{'sdshow'}) { last; }
          }
         print qq|
            <tr bgcolor="#808084" style="font-size:10px; color:#ffffff"><td colspan=4></td></tr>
           </tbody>
          </table><br><br>
         |;
         close(LF);
       }
      print qq|</a>\n|;
    }
   print $foottag;
 }

else    # NO ACTION
 { print $cgi->header . qq|$headtag
    <p> &nbsp;<a href="$sfile\?action=statview">Display Download Statistics</a></p>
    <table cellspacing=0 cellpadding=5 border=0><tbody style="font-family:Verdana">
     <tr><td colspan=2>Files Currently Tracked</td></tr>
   |;

   foreach my $id (sort {$a cmp $b} keys %FILES)
    { my $furl = $FILES{$id};
      $furl =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      print qq|<tr><td>$id</td><td><a href="$sfile\?action=download&fileid=$id">$furl</a></td></tr>\n|;
    }
 }

 print qq|\n</tbody></table><br><br>\n</p>\n$foottag|;

exit;

###############################################################################
#  FUNCTIONS  #################################################################

sub dtLogStampToDTShort
{
 my ($stamp) = @_;
 my $y = substr($stamp, 0, 4, '');
 my $m = substr($stamp, 0, 2, '');
 my $d = substr($stamp, 0, 2, '');
 my $nod = 'AM';
 my $hr = substr($stamp, 0, 2, '');
  ++$hr % 12 and $nod = 'PM';
    $hr > 12 and $hr -= 12;
 my $mn = substr($stamp, 0, 2, '');
 my $sc = substr($stamp, 0, 2, '');
 return "$m/$d/$y", "$hr\:$mn $nod";
}

sub getDTShort
{
 my ($sec, $min, $hour, $day, $month, $year, $weekday) = localtime(time);
 $year += 1900;
 (++$month) < 10 and $month = "0$month";
 $day  < 10 and $day  = "0$day";
 $hour < 10 and $hour = "0$hour";
 $min  < 10 and $min  = "0$min";
 $sec  < 10 and $sec  = "0$sec";
 return "$month/$day/$year", "$hour\:$min\:$sec";
}

sub getDTStamp
{
 my ($sec, $min, $hour, $day, $month, $year, $weekday) = localtime(time);
 $year += 1900;
 (++$month) < 10 and $month = "0$month";
 $day  < 10 and $day  = "0$day";
 $hour < 10 and $hour = "0$hour";
 $min  < 10 and $min  = "0$min";
 $sec  < 10 and $sec  = "0$sec";
 return "$year$month$day$hour$min$sec";
}
